home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HPAVC
/
HPAVC CD-ROM.iso
/
ML_VECTB.ZIP
/
SOURCE
/
VECTBALL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-05-04
|
18KB
|
715 lines
{
3D Vector Balls
by Maple Leaf, 1996
version 1.2 (update 3: 4th May 1996, -> system timer support added + speedups)
-----------------------------------------------------------------------
Using XMODE v1.1 and ENGINE3D v3.0, both (C)Copywrong by Maple Leaf.
-----------------------------------------------------------------------
No comments are necessarry. Theoretically, the program's running speed
depends only on the video card's speed. Conclusion: buy a video accelerator! :)
Leaving the jokes away, the 3D engine works very fast for such a small
number of points (48), and xImageOvr routine (from XMODE 1.1) has
been optimized for speed (by me!:), so there shouldn't be speed problems
in running this shitty program. If there are some, well, blame your
computer; I THINK it's not my fault...
}
uses engine3d, xmode, dosio, crt;
const
Forms = 8;
MaxHeights = 256;
{ Limits }
MaxRadius = 150;
MaxH = 100;
PagMin:byte= 0;
PagMax:byte= 3;
type
BallType = array [0..10] of record
x,y : integer;
data : array [byte] of byte;
end;
FormType = record
dots : integer;
data : array [0..47] of record x,y,z:integer end;
end;
var
putLogo : boolean;
Ball : array [0..2] of BallType;
Form : array [0..Forms-1] of FormType;
pal : array [byte] of record r,g,b:byte end;
origpal : array [byte] of record r,g,b:byte end;
capag, cvpag, cball : integer;
TiltStep, RotStep : Integer;
CFormModel : FormType; { Model for form-transforming }
CForm : FormType; { Current form }
CFormNr : Integer;
CPoints : array [0..50] of record
x : integer;
y : integer;
Zdist : longint; { 8 bytes }
end;
FCounter : word;
{}
Y_Val : array [0..MaxHeights-1] of Integer; { Heights }
YIndex : array [0..47] of Integer; { Y index }
YSpd : array [0..47] of Integer; { * Y variation speed }
Rad : array [0..47] of Integer; { Radius for each trajectory }
RadSpd : array [0..47] of Integer; { * Radius variation speed }
Ang : array [0..47] of Integer; { Angle for each trajectory }
AngSpd : array [0..47] of Integer; { * Angle variation speed }
{}
ML_BitMap : array [0..2999] of byte; {3 Kb}
old_int8 : pointer;
intr : array [byte] of pointer absolute 0:0;
const
Angles : array [0..Forms-1] of record RotA, TiltA : integer end = (
(RotA:2;TiltA:3),
(RotA:2;TiltA:3),
(RotA:-1;TiltA:3),
(RotA:2;TiltA:1),
(RotA:-2;TiltA:3),
(RotA:-3;TiltA:2),
(RotA:3;TiltA:1),
(RotA:-2;TiltA:1)
);
BallCol : array [0..Forms-1] of word = ( 0, 0, 0, 0, 0, 0, 0, 0 );
Procedure LoadData;
var f:file;
begin
Writeln('Loading data ...');
{ red ball }
openforinput(f,'data\redball.tab','');
blockread(f,Ball[0],260*11);
closefile(f,'');
{ blue ball }
openforinput(f,'data\blueball.tab','');
blockread(f,Ball[1],260*11);
closefile(f,'');
{ green ball }
openforinput(f,'data\grnball.tab','');
blockread(f,Ball[2],260*11);
closefile(f,'');
{ form #1 }
openforinput(f,'data\_init.bal','');
blockread(f,Form[0],290);
closefile(f,'');
{ form #2 }
openforinput(f,'data\_sphere.bal','');
blockread(f,Form[1],290);
closefile(f,'');
{ form #3 }
openforinput(f,'data\_cube.bal','');
blockread(f,Form[2],290);
closefile(f,'');
{ form #4 }
openforinput(f,'data\_jupiter.bal','');
blockread(f,Form[3],290);
closefile(f,'');
{ form #5 }
openforinput(f,'data\_2blobs.bal','');
blockread(f,Form[4],290);
closefile(f,'');
{ form #6 }
openforinput(f,'data\_triangl.bal','');
blockread(f,Form[5],290);
closefile(f,'');
{ form #7 }
openforinput(f,'data\_pyram.bal','');
blockread(f,Form[6],290);
closefile(f,'');
{ form #8 }
openforinput(f,'data\_cross.bal','');
blockread(f,Form[7],290);
closefile(f,'');
{ palette }
openforinput(f,'data\balls.pal','');
blockread(f,pal,768);
move(pal,origpal,768);
closefile(f,'');
{ ML bitmap }
openforinput(f,'data\ml.btm','');
blockread(f,ML_BitMap,93*31+4);
closefile(f,'');
end;
procedure Shit(s:string);
var k,p:byte;
const col:array[0..6] of byte = ( 8, 1, 3, 9, 11, 15, 7 );
begin
for k:=1 to length(s) do begin
for p:=0 to 6 do begin
textattr:=col[p];
write(s[k],#8);
delay(15);
end;
write(s[k]);
end;
writeln;
end;
Procedure DoneAll;
begin
Shit(' ──--∙ by Maple Leaf, 1996 ∙-───');
Shit(' * Hope you''ve enjoyed this shit *');
end;
Procedure UpdateForm1;near;assembler;
asm
inc FCounter
cmp FCounter,350
jb @Slide
{ First, update the form's index }
inc CFormNr
cmp CFormNr,Forms-1
jbe @Ok1
mov CFormNr,0
@Ok1:
{ Update the angles variation speed }
mov si,CFormNr
shl si,2
mov ax,word ptr Angles[si] {Rot}
mov bx,word ptr Angles[si+2] {Tilt}
mov RotStep,ax
mov TiltStep,bx
shr si,1
mov ax,word ptr BallCol[si]
mov CBall,ax
{ Update form model }
mov ax,ds
mov es,ax
mov si,CFormNr
shl si,1
mov ax,si { ax:=cformnr*2 }
shl si,4
add ax,si { ax:=cformnr*2+cformnr*32 }
shl si,3
add si,ax { si:=cformnr*2+cformnr*32+cformnr*256 = cformnr*290 }
add si,offset Form {!}
mov di,offset CFormModel
mov cx,145 {290/2}
rep movsw
{ Reset counter }
mov FCounter,0
jmp @Outta
@Slide:
{ Slide to the form shown by CFormModel }
mov si,offset CForm + 2
mov di,offset CFormModel + 2
mov cx,48
@Loop1:
{X}
mov ax,[si]
cmp ax,[di]
je @Next1
jl @Less1
dec ax
mov [si],ax
jmp @Next1
@Less1:
inc ax
mov [si],ax
@Next1:
{Y}
mov ax,[si+2]
cmp ax,[di+2]
je @Next2
jl @Less2
dec ax
mov [si+2],ax
jmp @Next2
@Less2:
inc ax
mov [si+2],ax
@Next2:
{Z}
mov ax,[si+4]
cmp ax,[di+4]
je @Next3
jl @Less3
dec ax
mov [si+4],ax
jmp @Next3
@Less3:
inc ax
mov [si+4],ax
@Next3:
add di,6 { Next coordinates }
add si,6 { -"- }
loop @Loop1
@Outta:
end;
procedure FastSort;near;assembler; { "Fast" enough for such an application... }
asm
push bp
mov si,4 + offset CPoints
mov cx,47
@Loop1:
mov bp,cx { save counter }
mov di,si
add di,8 { second value pointer }
@Loop2:
db 66h; mov ax,[di] { load second Z distance }
db 66h; cmp ax,[si]
jle @Nothing
{ Swap Z distances }
db 66h; mov bx,[si]
db 66h; mov [si],ax
db 66h; mov [di],bx
{ Swap X coords }
mov ax,[si-4]
mov bx,[di-4]
mov [si-4],bx
mov [di-4],ax
{ Swap Y coords }
mov ax,[si-2]
mov bx,[di-2]
mov [si-2],bx
mov [di-2],ax
{}
@Nothing:
add di,8
loop @Loop2
@NoLoop:
mov cx,bp { restore counter }
add si,8 { advance value pointer }
loop @Loop1 { loop it 47 times }
pop bp
end;
var i,dist,xx,yy:integer; yes:boolean;
procedure Display;near; { Displays the sorted balls }
begin
if PutLogo then ximageput(@ml_bitmap,227,169,capag);
for i:=0 to 47 do begin
asm
mov si,i
shl si,3
mov ax,word ptr CPoints[si+4]
sub ax,270
sar ax,4
cmp ax,10
jle @Ok1
mov ax,10
jmp @Ok2
@Ok1:
test ax,ax
jge @Ok2
xor ax,ax
@Ok2:
mov dist,ax
mov ax,word ptr Cpoints[si]
mov word ptr xx,ax
mov ax,word ptr Cpoints[si+2]
mov word ptr yy,ax
{}
mov yes,1
cmp xx,0
jl @NoWay
cmp yy,0
jl @NoWay
cmp xx,303
jg @NoWay
jmp @Yeah
@NoWay:
mov yes,0
@Yeah:
end;
if yes then ximageovr(@ball[cball][dist],xx,yy,capag);{}
{xvplot(xx,yy,100,capag);{}
end;
end;
Procedure DrawForm;near;assembler;
asm
{ Clear active page }
push capag
call xclrvpage
{ 3D to 2D mapping }
mov si,offset CForm+2
mov ax,ds
mov es,ax
mov di,offset CPoints
mov cx,48
@1: {X}
db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
add si,2
db 66h; mov word ptr _3dx,ax
{Y}
db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
add si,2
db 66h; mov word ptr _3dy,ax
{Z}
db 66h, 0Fh, 0BFh, 04h {movsx eax,word ptr [si]}
add si,2
db 66h; mov word ptr _3dz,ax
{}
db 66h; push cx
push si; push di
call IntMapCoordinates { Do mapping }
pop di; pop si
db 66h; pop cx
mov ax,word ptr _2dx; stosw { Store 2DX }
mov ax,word ptr _2dy; stosw { Store 2DY }
db 66h; mov ax,word ptr Zt
db 66h; stosw {stosd} { Store Z distance }
dec cx
jnz @1
{ Sort coordinates by Z distance }
call FastSort
{ Display }
call Display
end;
procedure FadeOut;near;assembler; { Quick slides the palette to white }
asm
push bp
mov cx,64
@Loop1:
mov bp,cx { Save counter }
{ "Increment" RGB fields }
mov cx,768
mov si,offset pal
mov di,si
@Loop2:
lodsb
inc al
cmp al,63
jbe @Ok1
mov al,63
@Ok1:
stosb
loop @Loop2
{ Wait for some horizontal retraces }
mov cx,1 { 4 times = 4 scan lines }
@Loop6:
mov dx,3dah
@Loop3:
in al,dx
test al,1
jne @Loop3
@Loop4:
in al,dx
test al,1
je @Loop4
loop @Loop6
{ Set new palette }
mov cx,256
mov si,offset pal
mov dx,3c8h
mov ah,0
@Loop5:
mov al,ah
out dx,al
inc dx
outsb
outsb
outsb
dec dx
inc ah
loop @Loop5
mov cx,bp { Restore counter }
loop @Loop1 { Loop it 64 times }
pop bp
end;
procedure FadeIn;near;assembler; { Quick slides the palette from white to normal }
asm
push bp
mov cx,64
@Loop1:
mov bp,cx { Save counter }
{ "Decrement" RGB fields }
mov cx,768
mov si,offset pal
mov di,offset origpal
@Loop2:
mov al,[si]
mov ah,[di]
cmp al,ah
je @Ok1
dec al
mov [si],al
@Ok1:
inc si
inc di
loop @Loop2
{ Wait for vertical retrace }
mov dx,3dah
mov cx,128
@Loop6:
@Loop3:
in al,dx
test al,1
jne @Loop3
@Loop4:
in al,dx
test al,1
je @Loop4
loop @Loop6
{ Set new palette }
mov cx,256
mov si,offset pal
mov dx,3c8h
mov ah,0
@Loop5:
mov al,ah
out dx,al
inc dx
outsb
outsb
outsb
dec dx
inc ah
loop @Loop5
mov cx,bp { Restore counter }
loop @Loop1 { Loop it 64 times }
pop bp
end;
var fc:word;
procedure accelerate;near;
const freq = 70; {?}
begin
port[$43]:=$36;
port[$40]:=lo($1234dc div freq);
port[$40]:=hi($1234dc div freq);
end;
procedure unaccelerate;near;
begin
port[$43]:=$36;
port[$40]:=$ff;
port[$40]:=$ff;
end;
procedure my8_part1;interrupt;
begin
asm
cli
db 66h; pusha
push es
end;
IncrAngle(RotAngle,RotStep); { Increment angles of rotation }
IncrAngle(TiltAngle,TiltStep);
UpdateForm1; { Update current form (fine slides) }
inc(fc);
asm
pop es
mov al,20h
out 20h,al
db 66h; popa
sti
end;
end;
procedure DoPart1;near; { **** PART ONE **** }
begin
{ Init pages }
capag:=pagmin;
cvpag:=pagmax;
{ Init angles' speeds }
RotStep:=2;
TiltStep:=3;
{ Init form }
cformnr:=0;
Fcounter:=320;
fc:=0;
cball:=0;
move(form[cformnr],cformModel,sizeof(formtype));
move(form[cformnr],cform,sizeof(formtype));
old_int8:=intr[8];
accelerate;
intr[8]:=@my8_part1;
repeat
xvwait; { Wait for vertical retrace }
xsetvpage(cvpag); { Set visual page }
DrawForm; { Draw form }
inc(capag); if capag>pagmax then capag:=pagmin; { Advance pages }
inc(cvpag); if cvpag>pagmax then cvpag:=pagmin;
until keypressed or (fc>=2450+150);
if keypressed then readkey;
FadeOut;
intr[8]:=old_int8;
unaccelerate;
end;
Procedure UpdateForm2;near;assembler;
asm
mov cx,48
xor si,si
mov di,offset CForm + 2
@Loop1:
push cx {save counter}
{ Increment Y index (using its speed) }
mov ax,word ptr YSpd[si]
mov bx,word ptr YIndex[si]
add bx,ax
cmp bx,MaxHeights-1
jle @Ok1
sub bx,bx
@Ok1:
mov word ptr YIndex[si],bx { Update index }
{ Extract height }
add bx,bx
mov ax,word ptr Y_Val[bx]
mov [di+2],ax { Set Y }
{ Increment radius (using its speed) }
mov ax,word ptr RadSpd[si]
mov bx,word ptr Rad[si]
add bx,ax
jge @Ok2
mov bx,0
@Ok2:
mov word ptr Rad[si],bx { Update radius }
{ Increment angle (using its speed) }
mov ax,word ptr AngSpd[si]
mov bx,word ptr Ang[si]
add bx,ax
jge @Ok4
add bx,360
jmp @Ok5
@Ok4:
cmp bx,359
jle @Ok5
sub bx,360
@Ok5:
mov word ptr Ang[si],bx { Update angle }
{ Compute X and Z coordinates }
shl bx,2
{ X:=radius*cos(angle) }
db 66h; mov cx,word ptr CosTab[bx]
mov ax,word ptr Rad[si]
db 66h; cbw {cwde}
db 66h; imul cx
db 66h; sar ax,8 {Normalize}
mov [di],ax { Set X coordinate }
{ Z:=radius*sin(angle) }
db 66h; mov cx,word ptr SinTab[bx]
mov ax,word ptr Rad[si]
db 66h; cbw {cwde}
db 66h; imul cx
db 66h; sar ax,8 {Normalize}
mov [di+4],ax { Set Z coordinate }
{ Update indexes }
add si,2
add di,6
pop cx
dec cx
jnz @Loop1
end;
var kk:word;
procedure my8_part2;interrupt;
begin
asm
cli
db 66h; pusha
push es
end;
UpdateForm2; { Update current form (fine slides) }
IncrAngle(RotAngle,RotStep); { Increment angles of rotation }
IncrAngle(TiltAngle,TiltStep);
inc(FCounter);
if FCounter=300 then begin
for kk:=0 to 47 do repeat AngSpd[kk]:=Random(5) until AngSpd[kk]<>0;
FCounter:=301;
end;
if (FCounter>=900) and (FCounter<900+MaxH) then begin
for kk:=0 to MaxHeights-1 do if Y_Val[kk]>0 then dec(Y_Val[kk]);
if ObserverY<0 then inc(ObserverY);
end;
if (FCounter=1050+MaxH) then RotStep:=1;
if (FCounter=1650+MaxH) then
for kk:=0 to 47 do RadSpd[kk]:=-1;
asm
pop es
mov al,20h
out 20h,al
db 66h; popa
sti
end;
end;
procedure DoPart2;near; { **** PART TWO **** }
var k:integer;
begin
xclrvram;
for capag:=pagmin to pagmax do if PutLogo then ximageput(@ml_bitmap,227,169,capag);
FadeIn;
{ Init }
capag:=pagmin;
cvpag:=pagmax;
SetAngles(0,110);
SetObserverPosition(0,40,300);
fillchar(Yindex,48*2,0);
fillchar(Ang,48*2,0);
fillchar(Rad,48*2,0);
for k:=0 to MaxHeights-1 do
Y_Val[k]:=Trunc(MaxH*sin(pi*k/MaxHeights));
randomize;
for k:=0 to 47 do begin
repeat YSpd[k]:=Random(5) until YSpd[k]>0;
rad[k]:=random(maxradius-40) + 40;
yindex[k]:=random(maxheights);
ang[k]:=random(360);
end;
cball:=1;
FCounter:=0;
RotStep:=0;
TiltStep:=0;
old_int8:=intr[8];
accelerate;
intr[8]:=@my8_part2;
repeat
xvwait; { Wait for vertical retrace }
xsetvpage(cvpag); { Set visual page }
DrawForm; { Draw form }
inc(capag); if capag>pagmax then capag:=pagmin; { Advance pages }
inc(cvpag); if cvpag>pagmax then cvpag:=pagmin;
until keypressed or (FCounter>=1650+MaxH+MaxRadius+50);
if keypressed then readkey;
FadeOut;
intr[8]:=old_int8;
unaccelerate;
end;
begin
LoadData;
If AskMessage('Do you want to permanently see the ML logo ? (lower speed if Yes)') then
PutLogo:=true
else
PutLogo:=false;
xinitvideo(0); pagmax:=3; {320x200/256/4pag}
xclrvram;
xsetpalette(@pal);
{ Init 3D engine }
Perspective:=True;
ZoomFactor:=250;
SetObserverPosition(0,0,300);
SetCamera(0,0,0);
SetAngles(0,0);
DoPart1; { Do the first part }
DoPart2; { Do the second part }
xclrvram;
FadeIn;
xtextmode(25);
DoneAll;
end.